Developer CD Series 1994…tember: Reference Library/Dev.CD Sep 94.toast/Periodicals/develop/develop Issue 11/develop 11 code/The NetWork Project/Examples (Sources)/NetSim/generic.p

Text File | 1992-07-15 | 7.7 KB | 318 lines | [TEXT/MPS ]

{© G. Sawitzki, StatLab Heidelberg 1986-1989}

{contains Generic event handlers and higher level functions}
{1/19/91 21:42:58    gs    removed initmenus, drawmenubar from setupthemenus}
{13.2.1988 23:05:15 Uhr    gs    cut/copy… included}

    UNIT Generic;
    INTERFACE
        uses MacUnits,StdTools;

    CONST    { Menu Numbers}
        mApple = 1;         { Apple menu ID. }
        mFile = 2;         { File menu ID. }
        mEdit = 3;         { Edit menu ID. }

procedure GenericApple (theitem: integer);

procedure SetUpTheMenus;
procedure GenericDrag (theEvent: Eventrecord; theWindow: WindowPtr);
PROCEDURE GenericMousedown (theEvent : Eventrecord; theWindow : WindowPtr);
PROCEDURE GenericGrowwindow (theEvent : Eventrecord; theWindow : WindowPtr);
{Handle mousedown in grow}
PROCEDURE GenericZoomWindow(fwreturncode:integer;theEvent : Eventrecord;theWindow : WindowPtr);

PROCEDURE GenericGoaway (VAR theWindow : WindowPtr);

PROCEDURE GenericActivate (theWindow : WindowPtr);

PROCEDURE GenericDeactivate (theWindow : WindowPtr);

procedure GenericUpdate (theWindow: WindowPtr);
procedure GenericDiskEvent (Message: Longint);
procedure updatecursor;
procedure GenericKeydown (theEvent: Eventrecord);
procedure GenericFprint (opnorpr, nrfils: integer); {Finder print}
procedure GenericEdit (theitem: integer);


implementation

procedure GenericAbout;
    var
        abType: ResType;
        abName: Str255;
        h: Handle;
        scri, AboutId: integer;
    begin
    {No names yet. To be changed…}
    {  h:=getNamedResource('ALRT','About');}
    {Translate Name to number}
    { if h=nil then OsCheck('Bad About..',ResError);}
    {    getResInfo(h,AboutId,abType,abName);}
        AboutId := 130;
        scri := StdAlert(AboutId, NoIcon);
    end;

procedure GenericApple; {Generic Response to Apple Menu selection}
    var
        Name: Str255;
        refnum: integer;
    begin
        if theitem = 1 then
            GenericAbout {  "About this program..." }
        else
        begin       { Otherwise find and open the desk accessory. }
            getitem(GetMHandle(mApple), theitem, Name);
            refnum := opendeskacc(Name);
        end;
    end;

{-------------------------------------------------------------------}
{init the user menus and draw menu bar. }

procedure SetUpTheMenus;{24.5.87}
    const
        mbarDisplayed = 128;
    var
        myHandle: MenuHandle;
        i: integer;
        laastMenu: integer;
        mbar: Handle;
    begin
        mbar := GetNewMBar(mbarDisplayed);
        if mbar <> nil then
        begin
            setMenubar(mbar);
            disposHandle(mbar);
        end;
        myHandle := getMenu(mApple);        { Get the Apple menu. }
        if myHandle <> nil then
            addresMenu(myHandle, 'DRVR');    { Add in the desk accessories. }
    end;

procedure GenericDrag (theEvent: Eventrecord; theWindow: WindowPtr);
    begin { If in the drag bar, let her drag it around. }
        if theWindow <> nil then
        begin {26.11.1990 0:49:29 Uhr    gs    }
            {make front, if not command pressed}
            if (theWindow <> frontwindow) and (bitand(theEvent.modifiers, cmdkey) = 0) then
                selectwindow(theWindow);
            dragwindow(theWindow, theEvent.where, system.dragrect);
        end;
    end;

    PROCEDURE GenericMousedown(theEvent : Eventrecord; theWindow : WindowPtr);
        VAR itemHit : integer;
    {Handle mousedown in content}
    BEGIN
        IF isDialogEvent(theEvent) then
            begin
             if DialogSelect(theEvent, theWindow, itemHit) THEN
                BEGIN
                    CASE itemHit OF
                        ok : BEGIN END;

                        cancel :  BEGIN END;
                        OTHERWISE
                    END;
                END{IsDialogSelect};
            END{isDialogEvent}

        ELSE
            BEGIN {no dialog event} END;
    END;

    PROCEDURE GenericGrowwindow;{ (theEvent : Eventrecord;theWindow : WindowPtr)}
    {Handle mousedown in grow}
    BEGIN END;

    PROCEDURE GenericZoomWindow(fwreturncode:integer;theEvent : Eventrecord;theWindow : WindowPtr);
    BEGIN END;

    PROCEDURE GenericGoaway; { (var theWindow : WindowPtr)}
    {will be called before the window is disposed}
    BEGIN END;

    PROCEDURE GenericActivate; {(theWindow : WindowPtr)}
    BEGIN END;

    PROCEDURE GenericDeactivate; {(theWindow : WindowPtr)}
    BEGIN END;


procedure GenericUpdate; {(theWindow : WindowPtr)}
    begin
{    beginupdate(theWindow);}
        if theWindow <> nil then
            drawcontrols(theWindow);{26.11.1990 1:00:09 Uhr    gs    }
{    endupdate(theWindow);}
    end;

procedure GenericDiskEvent;{(Message:Longint)}
    var
        dierr: integer;       { code returned by diskinit }
    begin { Disk insertion event: }
        if hiword(Message) <> NoErr then
            dierr := dibadmount(system.SFPutPoint, Message);
    end;

procedure updatecursor;
    begin
    end;

{procedure GenericKeydown(key:char;theEvent: Eventrecord);}
{begin end;}

procedure GenericKeydown; { (theEvent : Eventrecord)}
    type
        trick = packed record
                case boolean of
                    true: (
                            long: Longint
                    );
                    false: (
                            chr3, chr2, chr1, chr0: char
                    )
            end;

    var
        itemHit: integer;
        TrickVar: trick;
        charCode: char;
        dummy: boolean;
    begin
        if isDialogEvent(theEvent) then
        begin
            TrickVar.long := theEvent.Message;
            charCode := TrickVar.chr0;
            if (charCode = chr(3)) or (charCode = chr($0D)) then
            begin
  {same as ok}
  {---- open problem: how do you find the dialog ?}
            end;{newvalues}
            ;
        end;{dialogEvent}
    end;

procedure GenericFprint; {(opnorpr, nrfils : integer)}
 {Finder print}
    begin
    end;

procedure GenericPictEdit (var pic: PicHandle; owner: ptr; Action: cmdnumber);
    {perform a default cut/copy/paste/clear for pictures, with simple undo}

    var
        pHndl: Handle;
        length, offset: Longint;
        info: Handle;
        infoType: ResType;
        UndoOwner: ptr;

    begin
        if pic = nil then
            length := 0
        else
            length := getHandleSize(Handle(pic));
        case Action of
            cUndo:
            begin
                if GetUndo(info, infoType, UndoOwner, Action) = NoErr then
                    if (infoType = 'PICT') and (owner = UndoOwner) and (Action = cPaste) then
                    begin                                 {save present picture}
                        if PutUndo(Handle(pic), 'PICT', owner, cPaste) <> NoErr then {error handling}
                            ;
                        killPicture(pic);
                        pic := PicHandle(info);            {glue undo picture}
                    end;
            end;

            cCut:
                if pic <> nil then
                begin
                    if PutUndo(Handle(pic), 'PICT', owner, cPaste) <> NoErr then {error handling}
                        ;
                    if ZeroScrap <> NoErr then {error handling}
                        ;
                    if putscrap(length, 'PICT', ptr(pic^)) <> NoErr then
                        ;{error handling}
                    killPicture(pic);
                    pic := nil;
                end;
            cCopy:
                if pic <> nil then
                begin
                    ForgetUndo;
                    if ZeroScrap <> NoErr then {error handling}
                        ;

                    if putscrap(length, 'PICT', ptr(pic^)) <> NoErr then
                        ;{error handling}
            {Danger: putscrap may change the heap}
                end;
            cPaste:
            begin
                pHndl := NewHandle(0);
                if pHndl <> nil then
                begin
                    length := GetScrap(pHndl, 'PICT', offset);
                    if length < 0 then     {error handling}
                    else if length > 0 then     {no error, and got info}
                    begin
                        if PutUndo(Handle(pic), 'PICT', owner, cPaste) <> NoErr then {error handling}
                            ;
                        killPicture(pic);
                        pic := PicHandle(pHndl);
                    end;
                end;
            end;
            cClear:
            begin
                if PutUndo(Handle(pic), 'PICT', owner, cPaste) <> NoErr then {error handling}
                    ;
                killPicture(pic);
                pic := nil;
            end;
            otherwise
        end;{case}
    end;

procedure GenericEdit; {(theitem : integer)}
    {Default edit menu Action; supports only windows with registered pictures}

    var
        cmd: cmdnumber;
        oldpic, pic: PicHandle;
        safeport: grafptr;
        s: Str255;
        myself: ptr;
        tempfrontwindow: windowptr;
    begin
        getport(safeport);
        tempFrontWindow := frontWindow;{26.11.1990 0:48:47 Uhr    gs    }
        if tempFrontWindow <> nil then
        begin
            setport(tempFrontWindow);
            myself := ptr(tempFrontWindow);

            cmd := theitem + ceditbase - 1;
            oldpic := Getwindowpic(tempFrontWindow);
            pic := oldpic;
            GenericPictEdit(pic, myself, cmd);

            if pic <> oldpic then
            begin
                setwindowpic(tempFrontWindow, pic);
                with tempFrontWindow^ do
                begin
                    eraserect(portrect);
                    invalrect(portrect);
                end;
            end;
            setport(safeport);
        end;
    end;

end.